#
# A bounce address, in standard format
#
package Mail::Bounce::Address;

use strict;

use Carp;

use vars qw($strict %oktypes %okactions %explain);

$strict = 1;

%oktypes = map {$_ => 1}
("tempfail", "permfail", "warning");

%okactions = map {$_ => 1}
("failed", "delayed", "delivered", "relayed", "expanded");

# Table of explanations for status codes from RFC 1893
%explain = (
"5.1.1", "Bad destination mailbox address",
"5.1.2", "Bad destination system address",
	    );


sub new {
    my $class = shift;
    my $self = {};
    bless $self, $class;
}

# Type is generic kind of bounce - tempfail, permfail or warning
sub type {
    my $self = shift;
    my $arg = shift;
    if (defined($arg)) {
	croak "Illegal type value $arg" if $strict && !$oktypes{$arg};
	setget("type", $self, $arg);
    } else {
	setget("type", $self);
    }
}

sub action {
    my $self = shift;
    my $arg = shift;
    if (defined($arg)) {
	croak "Illegal action value $arg" if $strict && !$okactions{$arg};
	setget("action", $self, $arg);
    } else {
	setget("action", $self);
    }
}

# RFC 1894 status - 3-digit-group code. May have trailing text.
sub status {
    my $self = shift;
    my $arg = shift;
    if (defined($arg)) {
	croak "Illegal status value $arg" if $strict && $arg !~ /^\d+\.\d+\.\d+/;
	setget("status", $self, $arg);
    } else {
	setget("status", $self);
    }
}

sub diagnostic {
    my $self = shift;
    my $arg = shift;
    my $res = setget("diagnostic", $self, $arg);
    if (!defined($$self{"diagnostic"})) {
	if ($$self{"status"} =~ /^(\d+\.\d+\.\d+)/) {
	    if ($explain{$1}) {
		$res = $explain{$1};
	    }
	}
    }
    $res;
}

sub final_recipient {
    setget("final_recipient", @_);
}

# Original recipient, with fallback to final recipient if not set
sub original_recipient {
    my ($self, $arg) = @_;
    my $res = setget("original_recipient", @_);
    if (!defined($$self{original_recipient})) {
	$res = $$self{final_recipient};
    }
    $res;
}

sub reporting_mta {
    setget("reporting_mta", @_);
}

sub setget {
    my $name = shift;
    my $self = shift;
    my $arg = shift;

    $$self{$name} = $arg if defined($arg);
    if (!defined($$self{$name})) {
	return "<no $name>";
    } else {
	return $$self{$name};
    }
}

1;


